perm filename POOLTY.PAS[WEB,ALS] blob sn#664693 filedate 1982-06-24 generic text, type T, neo UTF8
{2}{$D-}
PROGRAM Pooltype(poolfile,output);
LABEL
    9999;
TYPE
    {5}asciicode=0..127;
VAR
    {7}xord:ARRAY[char]OF asciicode;
    xchr:ARRAY[asciicode]OF char;{12}k,l:0..127;
    m,n:char;
    s:integer;
    {16}poolfile:PACKED FILE OF char;
PROCEDURE Initialize;
    VAR
	{6}i:0..127;
    BEGIN
    {8}
    xchr[32]:=' ';     xchr[33]:='!';     xchr[34]:='"';     xchr[35]:='#';
    xchr[36]:='$';     xchr[37]:='%';     xchr[38]:='&';     xchr[39]:='''';
    xchr[40]:='(';     xchr[41]:=')';     xchr[42]:='*';     xchr[43]:='+';
    xchr[44]:=',';     xchr[45]:='-';     xchr[46]:='.';     xchr[47]:='/';
    xchr[48]:='0';     xchr[49]:='1';     xchr[50]:='2';     xchr[51]:='3';
    xchr[52]:='4';     xchr[53]:='5';     xchr[54]:='6';     xchr[55]:='7';
    xchr[56]:='8';     xchr[57]:='9';     xchr[58]:=':';     xchr[59]:=';';
    xchr[60]:='<';     xchr[61]:='=';     xchr[62]:='>';     xchr[63]:='?';
    xchr[64]:='@';     xchr[65]:='A';     xchr[66]:='B';     xchr[67]:='C';
    xchr[68]:='D';     xchr[69]:='E';     xchr[70]:='F';     xchr[71]:='G';
    xchr[72]:='H';     xchr[73]:='I';     xchr[74]:='J';     xchr[75]:='K';
    xchr[76]:='L';     xchr[77]:='M';     xchr[78]:='N';     xchr[79]:='O';
    xchr[80]:='P';     xchr[81]:='Q';     xchr[82]:='R';     xchr[83]:='S';
    xchr[84]:='T';     xchr[85]:='U';     xchr[86]:='V';     xchr[87]:='W';
    xchr[88]:='X';     xchr[89]:='Y';     xchr[90]:='Z';     xchr[91]:='[';
    xchr[92]:='\';     xchr[93]:=']';     xchr[94]:='↑';     xchr[95]:='_';
    xchr[96]:='`';     xchr[97]:='a';     xchr[98]:='b';     xchr[99]:='c';
    xchr[100]:='d';     xchr[101]:='e';     xchr[102]:='f';     xchr[103]:='g';
    xchr[104]:='h';     xchr[105]:='i';     xchr[106]:='j';     xchr[107]:='k';
    xchr[108]:='l';     xchr[109]:='m';     xchr[110]:='n';     xchr[111]:='o';
    xchr[112]:='p';     xchr[113]:='q';     xchr[114]:='r';     xchr[115]:='s';
    xchr[116]:='t';     xchr[117]:='u';     xchr[118]:='v';     xchr[119]:='w';
    xchr[120]:='x';     xchr[121]:='y';     xchr[122]:='z';     xchr[123]:='{';
    xchr[124]:='|';     xchr[125]:='}';     xchr[126]:='~';     xchr[0]:=' ';
    xchr[127]:=' ';
    {10}
    FOR i:=1 TO 31 DO xchr[i]:=Chr(i);
    xchr[24]:=Chr(95);     xchr[26]:=Chr(27);     xchr[27]:=Chr(126);
    {11}
    FOR i:=0 TO 127 DO xord[Chr(i)]:=127;
    FOR i:=1 TO 126 DO xord[xchr[i]]:=i;
    END;
    {13}
BEGIN
Initialize;
{14}
FOR k:=0 TO 127 DO
    BEGIN
    Write(k:3,': "');
    IF(k<32)AND({15}k IN[0,9..13,27])THEN
	Write(xchr[94],xchr[94],xchr[k+64]
	      )
    ELSE
	IF k=127 THEN
	    Write(xchr[94],xchr[94],xchr[63])
	ELSE
	    IF k=34 THEN
		Write(xchr[k],xchr[k])
	    ELSE
		Write(xchr[k]);
    Writeln('"');
    END;
s:=128;
{17}Reset(poolfile);
IF NOT Eof(poolfile)THEN
    REPEAT
	{18}
	BEGIN
	Read(poolfile,m,n);
	IF(xord[m]<48)OR(xord[m]>57)OR(xord[n]<48)OR(xord[n]>57)THEN
	    BEGIN
	    Writeln('! POOL line doesn''t begin with two digits');
	    GOTO 9999;
	    END;
	l:=xord[m]*10+xord[n]-48*11;
	Write(s:3,': "');
	FOR k:=1 TO l DO
	    BEGIN
	    IF Eoln(poolfile)THEN
		BEGIN
		Writeln('"');
		BEGIN
		Writeln('! That POOL line was too short');
		GOTO 9999;
		END;
		END;
	    Read(poolfile,m);
	    Write(xchr[xord[m]]);
	    IF xord[m]=34 THEN
		Write(xchr[34]);
	    END;
	Readln(poolfile);
	Writeln('"');
	s:=s+1;
	END;
    UNTIL Eof(poolfile)
ELSE
    BEGIN
    Writeln('! I can''t read the POOL file.');
    GOTO 9999;
    END;
9999:
END.